PGM=ICET00L

VB Script现学现用

这几天需要实现一个报表自动化的功能，用到批处理BAT和VBS的知识，属于现学现用。各种谷歌百度。都说好记性不如烂笔头，我打算花一篇的篇幅来记录用到的VB Script知识，另外用一篇的篇幅来记录用到的BAT批处理知识。希望可以积少成多。
(注意：VBS跟VBA不是一个概念，VBA只有在开启Excel的时候才能运行。) 

dim user_id, yyyymm, to_dte_       '定义变量

user_id = wscript.arguments(0)     '接收批处理传过来的第一个参数

CAP_user_id = Ucase(user_id)       '转换成大写

Select Case Mid(yyyymm,5,2)        'Select/Case的用法 和 字符串截取的方法                                         
Case "01"   
    ' do something here  
Case "02"                          'If-Then的用法，闰年的判断方法，=,<>,Mod的用法
  If (Mid(yyyymm,1,4) Mod 4=0) And (Mid(yyyymm,1,4) Mod 100<>0) Or (Mid(yyyymm,1,4) Mod 400=0) Then
   to_dte = yyyymm &"29"           '字符串拼接的用法
  else
   to_dte = yyyymm &"28"                 
  End If
Case "03" 
  ' do something here
Case "04" 
End Select 

if Weekday(to_dte)="7" Then        '判断任意一天是星期几的用法                             
  ' do something here
  End if
VBS替换text.txt文本中所有"AAAA"字符串为“BBBB"的方法
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
set f=fso.opentextfile("text.txt")
s=replace(f.readall,"AAAA","BBBB")
f.close
set f=fso.opentextfile("newtext.txt",2,true)
f.write s
f.close
VBS中提示框的用法
MsgBox "Error"    或者
WScript.Echo
VBS下取得当前运行脚本所在的当前目录的办法
set ws=createobject("wscript.shell")
WScript.Echo ws.currentdirectory
VBS中判断文件是否存在以及VBS移动、删除文件的用法
Set objFSO = Wscript.CreateObject("Scripting.FileSystemObject")
Const OverwriteExisting=True
my_file=ws.currentdirectory &"\my_file.txt"
my_file_fullpath =ws.currentdirectory & "\my_file.txt"
If objFSO.FileExists (my_file) Then               '判断文件存在 
  If objFSO.FileExists (my_file_fullpath) Then   
    objFSO.DeleteFile(my_file_fullpath)           '删除文件
   End If 
  objFSO.MoveFile my_file, my_file_fullpath       '移动文件
End If

下面是VBS操作excel的笔记

Set objExcel = CreateObject("Excel.Application")   '创建 excel 对象                               
If (Err.Number <> 0) Then
    Wscript.Echo "Excel application not found."
    Wscript.Quit
End If 

objExcel.Visible = True                            '设置excel可见

Set objBook = objExcel.Workbooks.Add()             '添加excel 工作簿
Set objSheet1= objBook.Sheets("Sheet1")

objSheet1.name="NEW_SHEET1"                        '重命名sheet(字符串拼接,用'&')
objSheet2.name="NEW_SHEET2"
objSheet3.name="NEW_SHEET3"

objSheet3.Activate                                 '设置Sheet3为当前编辑的活动sheet

objExcel.Range("A3:E20").Select                    '将A3:E20之间的数字类型当成文本类型显示
objExcel.Selection.NumberFormat = "@"

objExcel.Range("A1:E2").Interior.Color = RGB(220,230,241)  '设置区域内单元格底色(RGB值) 

With objExcel.ActiveWindow                         '(Freeze)固定首行和首列            
        .SplitColumn = 0
        .SplitRow = 1
End With

objExcel.Range("A3").Select                        '(Freeze)固定前面两行
objExcel.ActiveWindow.FreezePanes = True       

objExcel.Range("A1:B1").Select                     '单元格A1:B1合并
objExcel.Selection.MergeCells = True            

objExcel.Range("A1:B1").Select                     '字体加粗
objExcel.Selection.Font.Bold = True 

objExcel.Cells(1, 1).Value = "NEW_VALUE"           '单元格赋值

objExcel.Columns("A:A").ColumnWidth = 13.57        '设置整列宽  
objExcel.Columns("B:B").ColumnWidth = 15.71      

objExcel.Columns("G:G").Select                     '设置G列显示值的精度
objExcel.Selection.NumberFormat = "0.000000000"

objExcel.Rows("1:1").Select                        '首行显示筛选条件              
objExcel.Selection.AutoFilter

objExcel.ActiveWindow.ScrollColumn = 1             '让鼠标回到最左边
VBS实现对Excel的列自动填充
Const xlFillDefault = 0                        
objExcel.Range("H2").Select
objExcel.ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],Dict!R3C4:R227C5,2,FALSE)"        '这里以VLOOKUP公式举例，可以是任意公式
objExcel.Range("H2").AutoFill objExcel.Range("H2:H" &itotalline), xlFillDefault
VBS实现从外部text文件导入数据到当前sheet
Dim objFSO, objFile, l, aline, irow, icol, source_text    
Set objFSO  = CreateObject("Scripting.FileSystemObject")
source_text ="Source_feed_file.txt"
Set objFile = objFSO.OpenTextFile(source_text, ForReading)
irow= 2
While Not objFile.AtEndOfStream
        l = objFile.ReadLine 
        icol =1     
        aline = Split(l,";")                         'source文件是以”;"分隔的 
        Do Until icol > Ubound(aline)+1     
          objSheet.Cells(irow, icol) = aline(icol-1)      
          icol = icol + 1         
         Loop  
  irow = irow + 1
Wend
保存excel到当前目录，关闭并退出excel
objBook.SaveAs(ws.currentdirectory &"\NEW_EXCEL.xlsx") 
objBook.Close
objExcel.Quit

Comments !